home *** CD-ROM | disk | FTP | other *** search
/ Aminet 52 / Aminet 52 (2002)(GTI - Schatztruhe)[!][Dec 2002].iso / Aminet / dev / gg / ncurses-5.3.lha / ncurses-5.3 / Ada95 / samples / ncurses2-overlap_test.adb < prev    next >
Text File  |  2002-10-24  |  7KB  |  157 lines
  1. ------------------------------------------------------------------------------
  2. --                                                                          --
  3. --                       GNAT ncurses Binding Samples                       --
  4. --                                                                          --
  5. --                                 ncurses                                  --
  6. --                                                                          --
  7. --                                 B O D Y                                  --
  8. --                                                                          --
  9. ------------------------------------------------------------------------------
  10. -- Copyright (c) 2000 Free Software Foundation, Inc.                        --
  11. --                                                                          --
  12. -- Permission is hereby granted, free of charge, to any person obtaining a  --
  13. -- copy of this software and associated documentation files (the            --
  14. -- "Software"), to deal in the Software without restriction, including      --
  15. -- without limitation the rights to use, copy, modify, merge, publish,      --
  16. -- distribute, distribute with modifications, sublicense, and/or sell       --
  17. -- copies of the Software, and to permit persons to whom the Software is    --
  18. -- furnished to do so, subject to the following conditions:                 --
  19. --                                                                          --
  20. -- The above copyright notice and this permission notice shall be included  --
  21. -- in all copies or substantial portions of the Software.                   --
  22. --                                                                          --
  23. -- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS  --
  24. -- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF               --
  25. -- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.   --
  26. -- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM,   --
  27. -- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR    --
  28. -- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR    --
  29. -- THE USE OR OTHER DEALINGS IN THE SOFTWARE.                               --
  30. --                                                                          --
  31. -- Except as contained in this notice, the name(s) of the above copyright   --
  32. -- holders shall not be used in advertising or otherwise to promote the     --
  33. -- sale, use or other dealings in this Software without prior written       --
  34. -- authorization.                                                           --
  35. ------------------------------------------------------------------------------
  36. --  Author: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000
  37. --  Version Control
  38. --  $Revision: 1.1 $
  39. --  Binding Version 01.00
  40. ------------------------------------------------------------------------------
  41. with ncurses2.util; use ncurses2.util;
  42. with Terminal_Interface.Curses; use Terminal_Interface.Curses;
  43.  
  44. --  test effects of overlapping windows
  45.  
  46. procedure ncurses2.overlap_test is
  47.  
  48.    procedure fillwin (win : Window; ch : Character);
  49.    procedure crosswin (win : Window; ch : Character);
  50.  
  51.    procedure fillwin (win : Window; ch : Character) is
  52.       y1 : Line_Position;
  53.       x1 : Column_Position;
  54.    begin
  55.       Get_Size (win, y1, x1);
  56.       for y in 0 .. y1 - 1 loop
  57.          Move_Cursor (win, y, 0);
  58.          for x in 0 .. x1 - 1 loop
  59.             Add (win, Ch => ch);
  60.          end loop;
  61.       end loop;
  62.    exception
  63.       when Curses_Exception => null;
  64.          --  write to lower right corner
  65.    end fillwin;
  66.  
  67.    procedure crosswin (win : Window; ch : Character) is
  68.       y1 : Line_Position;
  69.       x1 : Column_Position;
  70.    begin
  71.       Get_Size (win, y1, x1);
  72.       for y in 0 .. y1 - 1 loop
  73.          for x in 0 .. x1 - 1 loop
  74.             if (((x > (x1 - 1) / 3) and (x <= (2 * (x1 - 1)) / 3))
  75.                 or (((y > (y1 - 1) / 3) and (y <= (2 * (y1 - 1)) / 3)))) then
  76.                Move_Cursor (win, y, x);
  77.                Add (win, Ch => ch);
  78.             end if;
  79.          end loop;
  80.       end loop;
  81.    end crosswin;
  82.  
  83.    --  In a 24x80 screen like some xterms are, the instructions will
  84.    --  be overwritten.
  85.    ch : Character;
  86.    win1 : Window := New_Window (9, 20, 3, 3);
  87.    win2 : Window := New_Window (9, 20, 9, 16);
  88. begin
  89.    Set_Raw_Mode (SwitchOn => True);
  90.    Refresh;
  91.    Move_Cursor (Line => 0, Column => 0);
  92.    Add (Str => "This test shows the behavior of wnoutrefresh() with " &
  93.         "respect to");
  94.    Add (Ch => newl);
  95.    Add (Str => "the shared region of two overlapping windows A and B. "&
  96.         "The cross");
  97.    Add (Ch => newl);
  98.    Add (Str => "pattern in each window does not overlap the other.");
  99.    Add (Ch => newl);
  100.  
  101.    Move_Cursor (Line => 18, Column => 0);
  102.    Add (Str => "a = refresh A, then B, then doupdate. b = refresh B, " &
  103.         "then A, then doupdaute");
  104.    Add (Ch => newl);
  105.    Add (Str => "c = fill window A with letter A.      d = fill window B " &
  106.         "with letter B.");
  107.    Add (Ch => newl);
  108.    Add (Str => "e = cross pattern in window A.        f = cross pattern " &
  109.         "in window B.");
  110.    Add (Ch => newl);
  111.    Add (Str => "g = clear window A.                   h = clear window B.");
  112.    Add (Ch => newl);
  113.    Add (Str => "i = overwrite A onto B.               j = overwrite " &
  114.         "B onto A.");
  115.    Add (Ch => newl);
  116.    Add (Str => "^Q/ESC = terminate test.");
  117.  
  118.    loop
  119.       ch := Code_To_Char (Getchar);
  120.       exit when ch = CTRL ('Q') or ch = CTRL ('['); --  QUIT or ESCAPE
  121.       case ch is
  122.          when 'a' => --  refresh window A first, then B
  123.             Refresh_Without_Update (win1);
  124.             Refresh_Without_Update (win2);
  125.             Update_Screen;
  126.          when 'b' => --  refresh window B first, then A
  127.             Refresh_Without_Update (win2);
  128.             Refresh_Without_Update (win1);
  129.             Update_Screen;
  130.          when 'c' => --  fill window A so it's visible
  131.             fillwin (win1, 'A');
  132.          when 'd' => --  fill window B so it's visible
  133.             fillwin (win2, 'B');
  134.          when 'e' => --  cross test pattern in window A
  135.             crosswin (win1, 'A');
  136.          when 'f' => --  cross test pattern in window B
  137.             crosswin (win2, 'B');
  138.          when 'g' => --  clear window A
  139.             Clear (win1);
  140.             Move_Cursor (win1, 0, 0);
  141.          when 'h' => --  clear window B
  142.             Clear (win2);
  143.             Move_Cursor (win2, 0, 0);
  144.          when 'i' => --  overwrite A onto B
  145.             Overwrite (win1, win2);
  146.          when 'j' => --  overwrite B onto A
  147.             Overwrite (win2, win1);
  148.          when others => null;
  149.       end case;
  150.    end loop;
  151.  
  152.    Delete (win2);
  153.    Delete (win1);
  154.    Erase;
  155.    End_Windows;
  156. end ncurses2.overlap_test;
  157.